home *** CD-ROM | disk | FTP | other *** search
/ Magnum One / Magnum One (Mid-American Digital) (Disc Manufacturing).iso / d12 / ddj1190.arc / DUNTEMAN.ASC < prev    next >
Text File  |  1990-10-27  |  3KB  |  109 lines
  1. _STRUCTURED PROGRAMMING COLUMN_
  2. by Jeff Duntemann
  3.  
  4. [LISTING ONE]
  5.  
  6. FUNCTION Modulus(X,Y : Integer) : Integer;
  7.  
  8. VAR
  9.   R : Real;
  10.  
  11. BEGIN
  12.   R := X/Y;
  13.   IF R < 0 THEN
  14.     Modulus := X-(Y*Trunc(R-1))
  15.   ELSE
  16.     Modulus := X-(Y*Trunc(R));
  17. END;
  18.  
  19.  
  20. [LISTING TWO]
  21.  
  22. PROGRAM ZelTest2;  { From DDJ 11/90 }
  23.  
  24. CONST
  25.   DayStrings : ARRAY[0..6] OF STRING =
  26.   ('Sunday','Monday','Tuesday','Wednesday','Thursday','Friday','Saturday');
  27.  
  28. VAR
  29.   Month, Day, Year : Integer;
  30.  
  31. { This function implements true modulus, rather than }
  32. { the remainder function as implemented in MOD.      }
  33.  
  34. FUNCTION Modulus(X,Y : Integer) : Integer;
  35.  
  36. VAR
  37.   R : Real;
  38.  
  39. BEGIN
  40.   R := X/Y;
  41.   IF R < 0 THEN
  42.     Modulus := X-(Y*Trunc(R-1))
  43.   ELSE
  44.     Modulus := X-(Y*Trunc(R));
  45. END;
  46.  
  47. FUNCTION CalcDayOfWeek(Year,Month,Day : Integer) : Integer;
  48.  
  49. VAR
  50.   Century,Holder : Integer;
  51.  
  52. BEGIN
  53.   { First test for error conditions on input values: }
  54.   IF (Year < 0)  OR
  55.      (Month < 1) OR (Month > 12) OR
  56.      (Day < 1)   OR (Day > 31) THEN
  57.      CalcDayOfWeek := -1  { Return -1 to indicate an error }
  58.   ELSE
  59.     { Do the Zeller's Congruence calculation as Zeller himself }
  60.     { described it in "Acta Mathematica" #7, Stockhold, 1887.  }
  61.     BEGIN
  62.       { First we separate out the year and the century figures: }
  63.       Century := Year DIV 100;
  64.       Year    := Year MOD 100;
  65.       { Next we adjust the month such that March remains month #3, }
  66.       {  but that January and February are months #13 and #14,     }
  67.       {  *but of the previous year*: }
  68.       IF Month < 3 THEN
  69.         BEGIN
  70.           Inc(Month,12);
  71.           IF Year > 0 THEN Dec(Year,1)      { The year before 2000 is }
  72.             ELSE                            { 1999, not 20-1...       }
  73.               BEGIN
  74.                 Year := 99;
  75.                 Dec(Century);
  76.               END
  77.         END;
  78.  
  79.       { Here's Zeller's seminal black magic: }
  80.       Holder := Day;                        { Start with the day of month }
  81.       Holder := Holder + (((Month+1) * 26) DIV 10); { Calc the increment }
  82.       Holder := Holder + Year;              { Add in the year }
  83.       Holder := Holder + (Year DIV 4);      { Correct for leap years  }
  84.       Holder := Holder + (Century DIV 4);   { Correct for century years }
  85.       Holder := Holder - Century - Century; { DON'T KNOW WHY HE DID THIS! }
  86.  
  87.       Holder := Modulus(Holder,7);          { Take Holder modulus 7  }
  88.  
  89.       { Here we "wrap" Saturday around to be the last day: }
  90.       IF Holder  = 0 THEN Holder := 7;
  91.  
  92.       { Zeller kept the Sunday = 1 origin; computer weenies prefer to }
  93.       { start everything with 0, so here's a 20th century kludge:     }
  94.       Dec(Holder);
  95.  
  96.       CalcDayOfWeek := Holder;  { Return the end product! }
  97.     END;
  98. END;
  99.  
  100. BEGIN
  101.   Write('Month (1-12): '); Readln(Month);
  102.   Write('Day   (1-31): '); Readln(Day);
  103.   Write('Year        : '); Readln(Year);
  104.   Writeln('The day of the week is ',
  105.            DayStrings[CalcDayOfWeek(Year,Month,Day)]);
  106.   Readln;
  107. END.
  108.  
  109.